;;;;
;;;; TOP-LEVEL FORMS
;;;;

;(define-method (eval (d definition) env)
;  (set (current-value (var d))
;       (eval (initial-value (var d))
;	     env)))

;;;;
;;;; PRIMITIVE EXPRESSIONS
;;;;

(define-method (eval (e constant) env)
  (value e))

(define-method (eval (e global-variable) env)
  (current-value e))

(define-method (eval (v local-variable) env)
  (let ((v-level (snl v)))
    (let loop ((level (snl env))
	       (e env))
      (if (= level v-level)
	  (vector-ref (values e)
		      (offset v))
	  (loop (- level 1)
		(parent e))))))

;;;;
;;;; COMPOUND EXPRESSIONS
;;;;

(define-method (eval (e application) env)
  (evaluate-call (eval (operator e) env)
		 (map (lambda (se)
			(eval se env))
		      (arguments e))))

(define-method (evaluate-call (p native-procedure) args)
  (apply (real-proc p) args))

(define-method (evaluate-call (p compound-procedure) args)
  (eval-body (body p)
	     (make-local-environment args (parent-environment p))))

(define-method (eval (e conditional) env)
  (if (eval (test e) env)
      (eval (consequent e) env)
      (if (null? (alternative e))
	  #f
	  (eval (alternative e) env))))

(define-method (eval (e lambda-expression) env)
  (new compound-procedure
       'anonymous
       (variables e)
       (body e)
       env))

(define-method (eval (e begin-expression) env)
  (eval-body (body e) env))

;;;;
;;;; HELPER FUNCTIONS
;;;;

(define (eval-body body e)
  (let loop ((b body))
    (cond ((null? b)
	   #f)
	  ((null? (cdr b))
	   (eval (car b) e))
	  (else
	   (eval (car b) e)
	   (loop (cdr b))))))

;;;;
;;;; RUN-TIME ENVIRONMENTS
;;;;

(define-class lexical-environment object
  (args values parent snl)
  (fields values parent snl))

(define (make-local-environment values parent)
  (new lexical-environment
       (apply vector values)
       parent
       (if parent
	   (+ (snl parent) 1)
	   1)))

;;;;
;;;; TESTING
;;;;

(define (repl)
  (display "Meta repl: ")
  (force-output (current-output-port))
  (let ((cmd (read)))
    (cond ((equal? cmd ',reset))
	  (else
	   (write (eval (simplify (parse cmd))
			#f))
	   (newline)
	   (repl)))))
